indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ------------------------------------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts --------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 219)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.76364 12.77514 12.78643 12.79751 12.80838 12.81904 12.82949 12.83973
## [9] 12.84977 12.85961 12.86924 12.87867 12.88790 12.89693 12.90576 12.91437
## [17] 12.92275 12.93089 12.93880 12.94648 12.95393 12.96116 12.96815 12.97493
## [25] 12.98147 12.98780 12.99390 12.99978 13.00544 13.01089 13.01611 13.02113
## [33] 13.02593 13.03051 13.03489 13.03905 13.04299 13.04670 13.05017 13.05342
## [41] 13.05643 13.05922 13.06178 13.06411 13.06623 13.06812 13.06980 13.07125
## [49] 13.07250 13.07353 13.07434 13.07495 13.07535 13.07555 13.07554 13.07533
## [57] 13.07491 13.07430 13.07349 13.07249 13.07129 13.06990 13.06832 13.06655
## [65] 13.06460 13.06246 13.06013 13.05763 13.05495 13.05209 13.04905 13.04520
## [73] 13.03993 13.03335 13.02551 13.01650 13.00640 12.99529 12.98324 12.97034
## [81] 12.95667 12.94230 12.92731 12.91178 12.89579 12.87942 12.86274 12.84585
## [89] 12.82881 12.81170 12.79461 12.77761 12.76078 12.74420 12.72794 12.71210
## [97] 12.69674 12.68195 12.66781 12.65438 12.64176 12.63002 12.61924 12.60950
## [105] 12.60088 12.59346 12.58741 12.58284 12.57966 12.57780 12.57720 12.57778
## [113] 12.57948 12.58221 12.58590 12.59050 12.59591 12.60208 12.60893 12.61639
## [121] 12.62439 12.63285 12.64171 12.65089 12.66032 12.66993 12.67965 12.68940
## [129] 12.69913 12.70874 12.71818 12.72737 12.73623 12.74471 12.75271 12.75886
## [137] 12.76218 12.76323 12.76257 12.76078 12.75842 12.75604 12.75423 12.75354
## [145] 12.75453 12.75778 12.76385 12.77247 12.78279 12.79450 12.80729 12.82085
## [153] 12.83486 12.84901 12.86299 12.87649 12.89107 12.90830 12.92789 12.94954
## [161] 12.97296 12.99786 13.02395 13.05092 13.07849 13.10636 13.13424 13.16183
## [169] 13.18885 13.21499 13.23997 13.26349 13.28525 13.30497 13.32235 13.33839
## [177] 13.35426 13.36992 13.38533 13.40044 13.41523 13.42963 13.44363 13.45717
## [185] 13.47021 13.48271 13.49463 13.50593 13.51657 13.52651 13.53570 13.54411
## [193] 13.55170 13.55841 13.56422 13.56908 13.57295 13.57579 13.57756 13.57821
## [201] 13.57771 13.57602 13.57308 13.56888 13.56355 13.55730 13.55013 13.54206
## [209] 13.53308 13.52320 13.51245 13.50081 13.48830 13.47493 13.46070 13.44563
## [217] 13.42972 13.41297 13.39540#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 219)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.58692 12.58136 12.57570 12.57002 12.56436 12.55879 12.55338 12.54819
## [9] 12.54328 12.53871 12.53456 12.53087 12.52772 12.52516 12.52327 12.52193
## [17] 12.52097 12.52036 12.52009 12.52013 12.52045 12.52103 12.52185 12.52287
## [25] 12.52408 12.52545 12.52696 12.52858 12.53028 12.53205 12.53385 12.53567
## [33] 12.53748 12.53924 12.54095 12.54258 12.54444 12.54688 12.54985 12.55333
## [41] 12.55729 12.56170 12.56653 12.57175 12.57734 12.58325 12.58947 12.59595
## [49] 12.60268 12.60963 12.61676 12.62404 12.63144 12.63894 12.64651 12.65411
## [57] 12.66172 12.66930 12.67683 12.68428 12.69161 12.69881 12.70583 12.71265
## [65] 12.71924 12.72557 12.73161 12.73734 12.74271 12.74770 12.75229 12.75691
## [73] 12.76197 12.76738 12.77306 12.77893 12.78489 12.79087 12.79678 12.80254
## [81] 12.80805 12.81324 12.81802 12.82230 12.82601 12.82905 12.83134 12.83279
## [89] 12.83333 12.83286 12.83131 12.82858 12.82256 12.81154 12.79604 12.77658
## [97] 12.75367 12.72784 12.69960 12.66947 12.63797 12.60561 12.57292 12.54042
## [105] 12.50862 12.47804 12.44920 12.42261 12.39881 12.37830 12.36160 12.34924
## [113] 12.34172 12.33770 12.33540 12.33474 12.33565 12.33805 12.34184 12.34696
## [121] 12.35332 12.36084 12.36944 12.37903 12.38955 12.40089 12.41299 12.42577
## [129] 12.43914 12.45302 12.46733 12.48198 12.49691 12.51203 12.52725 12.54407
## [137] 12.56372 12.58570 12.60954 12.63474 12.66082 12.68729 12.71366 12.73945
## [145] 12.76416 12.78732 12.80843 12.82887 12.85019 12.87214 12.89450 12.91702
## [153] 12.93948 12.96164 12.98327 13.00412 13.02573 13.04957 13.07533 13.10268
## [161] 13.13132 13.16093 13.19118 13.22177 13.25238 13.28268 13.31236 13.34112
## [169] 13.36862 13.39455 13.41860 13.44045 13.45979 13.47629 13.48964 13.50092
## [177] 13.51139 13.52102 13.52978 13.53764 13.54457 13.55053 13.55549 13.55943
## [185] 13.56230 13.56408 13.56474 13.56424 13.56256 13.55965 13.55550 13.55006
## [193] 13.54330 13.53521 13.52573 13.51484 13.50251 13.48871 13.47341 13.45657
## [201] 13.43816 13.41815 13.39651 13.37320 13.34836 13.32215 13.29456 13.26560
## [209] 13.23527 13.20357 13.17052 13.13611 13.10035 13.06324 13.02478 12.98499
## [217] 12.94385 12.90138 12.85758#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 219)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.26515 11.30513 11.34445 11.38309 11.42103 11.45827 11.49479 11.53058
## [9] 11.56563 11.59992 11.63344 11.66618 11.69812 11.72926 11.75957 11.78905
## [17] 11.81768 11.84545 11.87235 11.89836 11.92347 11.94766 11.97094 11.99329
## [25] 12.01475 12.03533 12.05504 12.07390 12.09193 12.10915 12.12557 12.14121
## [33] 12.15608 12.17022 12.18362 12.19631 12.20831 12.21963 12.23029 12.24030
## [41] 12.24970 12.25848 12.26667 12.27369 12.27903 12.28274 12.28489 12.28556
## [49] 12.28481 12.28272 12.27935 12.27478 12.26907 12.26230 12.25452 12.24582
## [57] 12.23627 12.22593 12.21487 12.20316 12.19087 12.17808 12.16485 12.15125
## [65] 12.13736 12.12323 12.10895 12.09458 12.08019 12.06584 12.05163 12.03760
## [73] 12.02383 12.01039 11.99735 11.98478 11.97275 11.96133 11.94917 11.93497
## [81] 11.91886 11.90101 11.88156 11.86066 11.83844 11.81507 11.79068 11.76543
## [89] 11.73946 11.71292 11.68595 11.65870 11.63133 11.60397 11.57678 11.54989
## [97] 11.52347 11.49765 11.47258 11.44842 11.42529 11.40337 11.38278 11.36369
## [105] 11.34623 11.33055 11.31680 11.30513 11.29568 11.28860 11.28404 11.28215
## [113] 11.28307 11.28697 11.29383 11.30344 11.31563 11.33020 11.34698 11.36577
## [121] 11.38639 11.40865 11.43237 11.45736 11.48344 11.51042 11.53811 11.56633
## [129] 11.59489 11.62360 11.65228 11.68075 11.70882 11.73630 11.76300 11.79070
## [137] 11.82100 11.85342 11.88751 11.92280 11.95882 11.99512 12.03123 12.06669
## [145] 12.10102 12.13378 12.16449 12.19506 12.22731 12.26070 12.29466 12.32862
## [153] 12.36202 12.39429 12.42489 12.45323 12.48112 12.51054 12.54124 12.57298
## [161] 12.60550 12.63855 12.67188 12.70524 12.73838 12.77104 12.80298 12.83393
## [169] 12.86367 12.89192 12.91844 12.94298 12.96528 12.98510 13.00219 13.01723
## [177] 13.03110 13.04383 13.05542 13.06591 13.07531 13.08365 13.09094 13.09720
## [185] 13.10246 13.10673 13.11004 13.11240 13.11385 13.11439 13.11405 13.11285
## [193] 13.11080 13.10794 13.10428 13.09984 13.09464 13.08870 13.08205 13.07470
## [201] 13.06667 13.05799 13.04867 13.03874 13.02812 13.01673 13.00456 12.99161
## [209] 12.97788 12.96337 12.94807 12.93197 12.91509 12.89741 12.87893 12.85964
## [217] 12.83956 12.81866 12.79695#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")